﻿(*   Copyright 2011 Alexander Omelchuk
 *
 *   Licensed under the Apache License, Version 2.0 (the "License");
 *   you may not use this file except in compliance with the License.
 *   You may obtain a copy of the License at
 *
 *       http://www.apache.org/licenses/LICENSE-2.0
 *
 *   Unless required by applicable law or agreed to in writing, software
 *   distributed under the License is distributed on an "AS IS" BASIS,
 *   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 *   See the License for the specific language governing permissions and
 *   limitations under the License.
 *)

namespace Lisp
open System
open System.Linq.Expressions

type IDynamicEnvironment = interface
  ///<summary>Gets or sets value of dynamic variable by its name.</summary>
  abstract member Item : name:string -> SExpr with get, set
  ///<summary>Creates new variable in current dynamic environment.</summary>
  abstract member CreateVar : string -> SExpr -> unit
end

/// <summary>
/// Global environment.
/// Contains imformation about dynamic variables, constants,
/// functions, macros and special operators.
/// </summary>
type GEnvironment private () = class
  static let instance = GEnvironment()
  static let functions = mkTable<Fun> ()
  static let compiledFunctions = mkTable<LambdaList*Delegate> ()
  static let constants = mkTable<Expression> ()
  let vars = mkTable<SExpr> ()

  ///<summary>Singleton instance of this class.</summary>
  static member Instance = instance

  ///<summary>Function known at compile-time</summary>
  static member Functions = functions

//  static member GetFunction name = 
//    let ok, value = compiledFunctions.TryGetValue(name)
//    if ok then value else raiseExprError undefinedFun (Id name)
  static member CreateFunction name value = compiledFunctions.[name] <- value

  static member Apply name env (args:SExpr[]) =
    let ok, value = compiledFunctions.TryGetValue(name)
    if not ok then raiseExprError undefinedFun (Id name)
    let (lambdaList, lambda) = value
    let args = args |> lambdaList.ToFuncArgs env |> Seq.toArray
    lambda.DynamicInvoke(args)
 
  static member GetConstant name =
    let ok,value = constants.TryGetValue(name)
    if ok then Some value else None
  static member CreateConstant name value = 
    constants.Add(name, value)
  static member IsConstant name = constants.ContainsKey name

  interface IDynamicEnvironment with
    member x.Item
      with get name = 
        let ok, var = vars.TryGetValue(name)
        if ok then var else raiseExprError varHasNoValue (Id name)
      and set name value =
        if constants.ContainsKey(name) then raiseExprError isConstant (Id name)
        else vars.[name] <- value
    member x.CreateVar name value = (x:>IDynamicEnvironment).[name] <- value

  //member x.LoadPackage
end

/// <summary>
/// Dynamic environment.
/// Contains information aboue dynamic variables and active catch tags.
/// </summary>
type DEnvironment (parent:IDynamicEnvironment) =
  let vars = mkTable<SExpr> ()
  let mutable catchTag : SExpr option = None

  member env.Parent = parent

  interface IDynamicEnvironment with
    member env.Item
      with get(name) = let ok, var = vars.TryGetValue(name)
                       if ok then var
                       else parent.[name]
      and set name v = if vars.ContainsKey(name)
                       then vars.[name] <- v
                       else parent.[name] <- v
    ///<summary>Sets variable in current environment.</summary>
    member env.CreateVar name value = vars.[name] <- value

/// <summary>
/// Lexical environment.
/// Contains lexical variables, local functions, current block name
/// </summary>
type LEnvironment (parent:LEnvironment option,
                   blockSignature:(string*ParameterExpression) option) =
  static let mutable currentId = 0
  ///<summary>Lexical variables that are resolved in compile-time.</summary>
  let vars = mkTable<Expression> ()
  let funcs = mkTable<Fun> ()
  let id = currentId
  do currentId <- currentId + 1

  new(parent:LEnvironment) = LEnvironment(Some parent, None)

  ///<summary>Unique identifier of the environmnt</summary>
  member env.Id = id
  ///<summary>Block name and block end label.</summary>
  member env.BlockSignature = blockSignature
  member env.Parent = parent

  member env.GetVar name =
    let ok, var = vars.TryGetValue(name)
    if ok then Some var
    else match parent with     
         | Some p -> p.GetVar name
         | None   -> GEnvironment.GetConstant name
  member env.CreateVar name =
    let var = Expression.Variable(typeof<SExpr>, name)
    vars.[name] <- var
    var
  
  member env.GetFunction name =
      let ok, func = funcs.TryGetValue(name)
      if ok then Some func
      else match parent with     
           | Some p -> p.GetFunction name
           | None -> let ok, op = GEnvironment.Functions.TryGetValue(name)
                     if ok then Some op else None
  ///<summary>Creates new function in this lexical environment.</summary>
  member env.CreateFunction name value = funcs.[name] <- value

// constructor with non-tupled parameters would do better
type Throw(tag: SExpr, result:SExpr) =
  inherit exn()
  member x.Tag = tag
  member x.Result = result

type ReturnFrom(envId:int, result:SExpr) =
  inherit exn()
  member x.EnvId = envId
  member x.Result = result